home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1996 December / PC Answers December 1996.iso / create / corelcad / cad / command.csc < prev    next >
Encoding:
Text File  |  1996-04-25  |  52.1 KB  |  1,985 lines
  1. 'This script simulates a command line. It enables users to perform most CorelCAD commands using a command line interface.
  2. '
  3. '*************************************************************************************
  4. '**********************      COMMAND LINE      **********************************
  5. '*************************************************************************************
  6. '*************************************************************************************
  7. 'April 25, 1996
  8. '
  9. '          This script simulates a command line. It enables the user to perform many CorelCAD 
  10. '    commands using the keyboard. A list of commands and/or objects is available by typing "LIST".         
  11. '
  12. '
  13. '        Coordinate entry is possible through two main methods:
  14. '
  15. '    Normal:             5,5,5
  16. '    Relative:            @5,5,5
  17. '
  18. 'Written by Dave Climie,        ⌐ 1995-1996 Corel Corporation. All rights reserved.
  19. '*************************************************************************************
  20. '*************************************************************************************
  21. '************************      DECLARATIONS      *************************************
  22. '*************************************************************************************
  23. '*************************************************************************************
  24. DECLARE SUB DoMove()
  25. DECLARE SUB DoScale()
  26. DECLARE SUB DoExtrude()
  27. DECLARE SUB DoPaste()
  28. DECLARE SUB DoChangeColor()
  29. DECLARE SUB DoZoom()
  30.  
  31. DECLARE SUB GetCoord (DiaText$,X#,Y#,Z#,ESC%)        'allows user to enter a coordinate (x,y,z)
  32. DECLARE SUB GetValue (DiaText$,dX#,ESC%)            'allows user to enter a magnitude (distance, angle, etc..)
  33. DECLARE SUB GetLetter (TitleText$,DiaText$,LetAvail$,LetPicked$,ESC%)
  34.  
  35. DECLARE SUB Array()                            'array functions
  36.     DECLARE SUB LinearArr(DoOverall%, ESC%)
  37.     DECLARE SUB TwoDArr(DoOverall%, ESC%)
  38.     DECLARE SUB ThreeDArr(DoOverall%, ESC%)    
  39.     DECLARE SUB CircleArr(ESC%)
  40.     DECLARE SUB SpiralArr(ESC%)
  41.     DECLARE SUB SphereArr(ESC%)
  42.  
  43. DECLARE SUB CreateArc()                        'arc drawing functions
  44.     DECLARE SUB CreateArc3Points(WireFlag%, ESC%)        'WIREFLAG FOR PROPERTIES:
  45.     DECLARE SUB CreateArcAngle(WireFlag%, ESC%)                    '0: WIRE ARC
  46.     DECLARE SUB CreateArcCSE(WireFlag%, ESC%)                    '1: CENTER (creates surface)
  47.     DECLARE SUB CreateArcEllipses(WireFlag%, ESC%)                '2: END POINT (creates surface)
  48.     DECLARE SUB CreateArcRSE(WireFlag%, ESC%)
  49.  
  50. DECLARE SUB CreateBox()    'box drawing function
  51.  
  52. DECLARE SUB CreateCircle()    'circle drawing functions
  53.     DECLARE SUB CreateCircle3Point(WireFlag%, ESC%)
  54.     DECLARE SUB CreateCircleDiameter(WireFlag%, ESC%)
  55.     DECLARE SUB CreateCircleRadius(WireFlag%, ESC%)
  56.  
  57. DECLARE SUB CreateCone()                        'draws cone
  58. DECLARE SUB CreateCylinder()                    'draws cylinder
  59.  
  60. DECLARE SUB CreateEllipse()
  61. DECLARE SUB CreateFrustum()
  62. DECLARE SUB CreateHemisphere()
  63. DECLARE SUB CreateLine (PolyFlag%)                'Boolean, True for Polyline, False for Line Segments
  64. DECLARE SUB CreatePolygon()
  65. DECLARE SUB CreateRectangle()
  66. DECLARE SUB CreateSphere()
  67. DECLARE SUB CreateTorus()
  68. '*************************************************************************************
  69. '*****************************    VARIABLE DECLARATIONS   ****************************
  70. '*************************************************************************************
  71.  
  72. GLOBAL Objects$(15)
  73. GLOBAL Command$(30)
  74.  
  75. GLOBAL ObjPicked% 
  76. GLOBAL CmdPicked% 
  77.  
  78.     ObjPicked = 1            'sets these as the default to display to the user
  79.     CmdPicked = 1
  80.  
  81. '*************************************************************************************
  82. '*************************************************************************************
  83. '************************       MAIN      ********************************************
  84. '*************************************************************************************
  85. '*************************************************************************************
  86. '*************************************************************************************
  87.  
  88. DIM Entry$        'Used to store what is typed in by user at command line
  89. DIM WhichList$        ' Stores the type of list the user wants to see
  90.  
  91. Start:
  92.  
  93.     Entry$=""
  94.  
  95.     BEGIN DIALOG Commnd 47, 372, 254, 16, "Command Bar"
  96.         TEXTBOX  82, 2, 79, 13, Entry$
  97.         OKBUTTON  170, 1, 40, 15
  98.         CANCELBUTTON  214, 1, 40, 15
  99.         TEXT  4, 4, 76, 11, "Type Command or (L)ist:"
  100.     END DIALOG
  101.  
  102.     ret=DIALOG(Commnd)
  103.     if ret=2 then stop
  104.  
  105.     Entry$=UCASE(Entry$)
  106.     Entry$=LTRIM(Entry$)
  107.     Entry$=RTRIM(Entry$)
  108.  
  109.  
  110. WITHOBJECT "CorelCAD.Automation.1"
  111.  
  112.     SELECT CASE Entry$
  113.         CASE "A","ARC"
  114.             CreateArc
  115.         CASE "AR","ARR","ARRAY"
  116.             Array
  117.         CASE "B","BO","BOX"
  118.             CreateBox
  119.         CASE "C","CIRC","CIRCLE","CIR","CI"
  120.             CreateCircle
  121.         CASE "COL","COLO","COLOR","COLOUR","CHANGE","CHANGE COLOR"    
  122.             DoChangeColor
  123.         CASE "CL","CLOSE"
  124.             .FileClose
  125.         CASE "CO","CONE"
  126.             CreateCone 
  127.         CASE "COPY","COP"
  128.             .EditCopy     
  129.         CASE "CY","CYLINDER","CYL"
  130.             CreateCylinder
  131.         CASE "D","DEF","DEFINE"
  132.             .SolidDefine
  133.         CASE "DEL","DELETE"
  134.             .DeleteSelection
  135.         CASE "DE","DES","DESELECT","DESELECT ALL"
  136.             .SelectPointAt 1000,1000, -1, -1
  137.         CASE "DU","DUPE","DUPLICATE"
  138.             .Duplicate
  139.         CASE "E","ELLIPSE","EL","ELL"
  140.             CreateEllipse
  141.         CASE "EXIT"
  142.             Goto DONEALL    
  143.         CASE "EXPLODE","EX","EXP","EXPL"
  144.             .SolidExplode
  145.         CASE "EXT","EXTRUDE"
  146.             DoExtrude
  147.         CASE "F","FR","FRU","FRUSTUM"
  148.             CreateFrustum
  149.         CASE "G","GR","GRO","GROU","GROUP"
  150.             .Group
  151.         CASE "H","HEMI","HEMISPHERE"
  152.             CreateHemisphere
  153.         CASE "HIDE","HIDDEN","HI"
  154.            .HideEntireView false, false, false, false
  155.         CASE "L","LIST"
  156.             goto LIST
  157.         CASE "LI","LIN","LINE"    
  158.             CreateLine FALSE 
  159.         CASE "M","MO","MOVE"
  160.             DoMove
  161.         CASE "N","NEW"    
  162.             .FileNew
  163.         CASE "PA","PAS","PASTE"
  164.             DoPaste
  165.         CASE "P","PO","POLYLINE"
  166.             CreateLine  TRUE
  167.         CASE "POLY", "POLYGON","TRIANGLE"
  168.                Createpolygon
  169.         CASE    "Q","QUIT"
  170.             Goto DONEALL
  171.         CASE "R","RE","RED","REDO"
  172.             .Redo
  173.         CASE "REC","RECT","RECTANGLE","SQUARE"
  174.             CreateRectangle
  175.         CASE "REF","REFRESH"
  176.             .WireFrame
  177.         CASE "REN","REND","RENDER","RENDER VIEW","RENDERED VIEW","SH","SHADE","SHADE VIEW","SHADED VIEW"
  178.             .ShadeEntireView TRUE, TRUE, 1, TRUE
  179.         CASE "S","SC","SCA","SCALE"
  180.             DoScale
  181.         CASE "SA","SE","SELECTALL","SELECT","SELECT ALL"
  182.             .SelectAll    
  183.         CASE "SP","SPH","SPHERE"
  184.             CreateSphere
  185.         CASE "T","TO","TOR","TORUS"
  186.             CreateTorus
  187.         CASE "U","UN","UND","UNDO"
  188.             .Undo
  189.         CASE "UNG","UNGR","UNGROUP","UN GROUP","UN-GROUP"
  190.             .UnGroup
  191.         CASE "V"
  192.             DoMove
  193.          CASE "W","WI","WIRE","WIREFRAME"
  194.             .WireFrame
  195.         CASE "X"
  196.             .SolidExplode
  197.         CASE "Z","ZOO","ZOOM"
  198.             DoZoom
  199.         CASE "ZA","ZOOM ALL"
  200.             .zoomToAll
  201.         CASE "ZO","ZOOM OUT"
  202.             .zoomout
  203.         CASE "ZI","ZOOM IN"
  204.             T1: 
  205.             GetCoord "Enter the first point for the zoom box:",X#,Y#,Z#,ESC%
  206.             If ESC = true then goto T2
  207.             GetCoord "Enter the end point for the zoom box:",X1#,Y1#,Z1#,ESC%
  208.             If ESC = true then goto T1
  209.             .ZoomIn X,Y,Z,X1,Y1,Z1
  210.             T2:
  211.         CASE "ZP","ZOOM PREVIOUS"
  212.             .zoomprevious
  213.         CASE "ZS","ZOOM SEL","ZOOM SELECTED","ZOOM TO SELECTED"
  214.             .zoomtoselected
  215.         CASE else
  216.             Message "Command does not exist."
  217.             GOTO START
  218.         END SELECT
  219.  
  220.     GOTO START
  221. END WITHOBJECT
  222.  
  223. '*************************************************************************************
  224. LIST:
  225.  
  226. DIM ESC%
  227.  
  228.     ESC = FALSE
  229.     GetLetter "List Type","(C)ommand List or (O)bject List ?","CO",WhichList$,ESC%
  230.  
  231.     If ESC = TRUE then Goto Start
  232.  
  233.     Select Case WhichList    
  234.         CASE "O"
  235.             Goto LISTOBJ
  236.         CASE "C"
  237.             Goto LISTCOM
  238.     End Select
  239.  
  240. '*************************************************************************************
  241. LISTCOM:
  242.  
  243. Command(1) = "Array"
  244. Command(2) = "Change Color"
  245. Command(3) = "Close File"                'This is the list of commands available to be executed
  246. Command(4) = "Copy"                        ' (Displayed when user prompts for command list)
  247. Command(5) = "Define Object"
  248. Command(6) = "Delete"
  249. Command(7) = "Deselect All"
  250. Command(8) = "Draw an object"
  251. Command(9) = "Duplicate"
  252. Command(10) = "Explode Object"
  253. Command(11) = "Extrude"
  254. Command(12) = "Group"
  255. Command(13) = "Hidden Line View"
  256. Command(14) = "List of Objects"
  257. Command(15) = "Move"
  258. Command(16) = "New File"
  259. Command(17) = "Object List"
  260. Command(18) = "Paste"
  261. Command(19) = "Redo"
  262. Command(20) = "Refresh"
  263. Command(21) = "Rendered View"
  264. Command(22) = "Scale"
  265. Command(23) = "Select All"
  266. Command(24) = "Undo"
  267. Command(25) = "Ungroup"
  268. Command(26) = "Zoom Commands"
  269. Command(27) = "Zoom To All"
  270. Command(28) = "Zoom To Selected"
  271. Command(29) = "Zoom Out"
  272. Command(30) = "Zoom Previous"
  273.  
  274.     BEGIN DIALOG DDlistboxdlg 47, 372, 254, 16, "Command List"
  275.         TEXT  4, 4, 90, 8, "&List:"
  276.         DDLISTBOX  23, 2, 138, 106, Command,CmdPicked
  277.         OKBUTTON  170, 1, 40, 15
  278.         CANCELBUTTON  214, 1, 40, 15
  279.     END DIALOG
  280.  
  281.     ret = DIALOG(DDlistboxdlg)
  282.     if ret = 2 then goto LIST
  283.  
  284. WITHOBJECT "CorelCAD.Automation.1"
  285.     SELECT CASE CmdPicked
  286.         CASE 1
  287.             Array
  288.         CASE 2    
  289.             DoChangeColor
  290.         CASE 3
  291.             .FileClose
  292.         CASE 4
  293.             .EditCopy
  294.         CASE 5
  295.             .SolidDefine
  296.         CASE 6
  297.             .DeleteSelection
  298.         CASE 7
  299.             .SelectPointAt 1000,1000,-1,-1
  300.         CASE 8
  301.             Goto LISTOBJ
  302.         CASE 9
  303.             .Duplicate
  304.         CASE 10
  305.             .SolidExplode
  306.         CASE 11
  307.             DoExtrude
  308.         CASE 12
  309.             .Group
  310.         CASE 13
  311.                .Dohide 
  312.         CASE 14
  313.             goto LISTOBJ
  314.         CASE 15
  315.             DoMove
  316.         CASE 16
  317.             .FileNew
  318.         CASE 17
  319.             Goto LISTOBJ
  320.         CASE 18
  321.             DoPaste
  322.         CASE 19
  323.             .redo
  324.         CASE 20
  325.             .wireframe
  326.         CASE 21
  327.             .ShadeEntireView TRUE, TRUE, 1, TRUE
  328.         CASE 22
  329.             DoScale
  330.         CASE 23
  331.             .SelectAll
  332.         CASE 24
  333.             .Undo
  334.         CASE 25
  335.             .Ungroup
  336.         CASE 26
  337.             DoZoom
  338.         CASE 27
  339.             .ZoomToAll
  340.         CASE 28
  341.             .ZoomToSelected
  342.         CASE 29
  343.             .ZoomOut
  344.         CASE 30
  345.             .ZoomPrevious
  346.         CASE else
  347.             Message "Undefined command"
  348.     end SELECT
  349. END WITHOBJECT
  350.  
  351. GOTO LISTCOM
  352. '*************************************************************************************
  353. LISTOBJ:
  354.  
  355. Objects(1) = "ARC"                        'This is the list of Objectss available to be drawn
  356. Objects(2) = "BOX"                        ' (Displayed when user prompts for Objects list)
  357. Objects(3) = "CIRCLE"                    
  358. Objects(4) = "COMMAND LIST"
  359. Objects(5) = "CONE"
  360. Objects(6) = "CYLINDER"
  361. Objects(7) = "ELLIPSE"
  362. Objects(8) = "FRUSTUM"
  363. Objects(9) = "HEMISPHERE"
  364. Objects(10) = "LINE SEGMENTS"
  365. Objects(11)= "POLYGON"
  366. Objects(12) = "POLYLINE"
  367. Objects(13) = "RECTANGLE"
  368. Objects(14) = "SPHERE"
  369. Objects(15) = "TORUS"
  370.  
  371.  
  372.     BEGIN DIALOG ListObBox 47, 372, 254, 16, "Object List"
  373.         TEXT  4, 4, 90, 8, "&List:"
  374.         DDLISTBOX  23, 2, 138, 106, Objects,ObjPicked
  375.         OKBUTTON  170, 1, 40, 15
  376.         CANCELBUTTON  214, 1, 40, 15
  377.     END DIALOG
  378.  
  379. Return = DIALOG(ListObBox)
  380. If Return = 2 then goto LIST
  381.  
  382. WITHOBJECT "CorelCAD.Automation.1"
  383.     SELECT CASE ObjPicked
  384.         CASE 1
  385.             CreateArc
  386.         CASE 2
  387.             CreateBox
  388.         CASE 3
  389.             CreateCircle
  390.         CASE 4
  391.             Goto LISTCOM
  392.         CASE 5
  393.             CreateCone
  394.         CASE 6
  395.             CreateCylinder
  396.         CASE 7
  397.             CreateEllipse
  398.         CASE 8
  399.             CreateFrustum
  400.         CASE 9
  401.             CreateHemisphere
  402.         CASE 10
  403.             CreateLine FALSE
  404.         CASE 11
  405.             CreatePolygon
  406.         CASE 12
  407.             CreateLine TRUE
  408.         CASE 13
  409.             CreateRectangle
  410.         CASE 14
  411.             CreateSphere
  412.         CASE 15
  413.             CreateTorus
  414.         CASE ELSE
  415.             Message "Undefined Command"
  416.     End Select
  417.         
  418. END WITHOBJECT
  419.  
  420. GOTO LISTOBJ
  421. DONEALL:
  422. '*************************************************************************************
  423. '*************************************************************************************
  424. '**************************      DRAWING FUNCTIONS           *************************
  425. '*************************************************************************************
  426. '*************************************************************************************
  427. SUB Array
  428.  
  429. DIM Correct%
  430. DIM TypeArray$
  431. DIM DistanceType$
  432. DIM DoOverall%
  433. DIM ESC%
  434.  
  435. DOARRAY:
  436.     ESC = False
  437.     GetLetter "ARRAY -- Define type","(L)in,(2)D,(3)D,(C)irc,(S)piral,S(p)here","L23CSP",TypeArray$,ESC%
  438.     If ESC = True then GOTO DoneArray            'takes user back to command line
  439.     
  440.     Correct = CBOL(INSTR("L23",TypeArray))
  441.  
  442.     If Correct = true then
  443. StepArray:
  444.         ESC = false
  445.         GetLetter "Distance Mode","(I)ncremental or (O)verall distance ?","IO",DistanceType$,ESC%        
  446.         If ESC = True then GOTO DOARRAY        'takes user back to "array -- define type"
  447.         If DistanceType = "O" then DoOverall = 1
  448.             else DoOverall = 0
  449.     END IF
  450.  
  451.     SELECT CASE TypeArray$
  452.         CASE "L"
  453.             LinearArr DoOverall,ESC 
  454.             If ESC = true then goto StepArray
  455.         CASE "2"
  456.             TwoDArr DoOverall,ESC
  457.             If ESC = true then goto StepArray            
  458.         CASE "3"
  459.             ThreeDArr DoOverall,ESC
  460.             If ESC = true then goto StepArray            
  461.         CASE "C"
  462.             CircleArr ESC 
  463.             If ESC = true then goto DoArray        
  464.         CASE "S"
  465.             SpiralArr ESC 
  466.             If ESC = true then goto DoArray
  467.         CASE "P"
  468.             SphereArr ESC 
  469.             If ESC = true then goto DoArray
  470.         END SELECT
  471.  
  472. DoneArray:
  473. END SUB
  474. '*************************************************************************************
  475. SUB LinearArr (DoOverall%,ESC%)
  476.  
  477. DIM NumCop#
  478. DIM NumCopies%
  479. DIM dX#,dY#,dZ#
  480.  
  481. Lin1:
  482.     GetValue  "LINEAR ARRAY -- # of copies",NumCop#,ESC%
  483.     NumCopies=cint(NumCop)
  484.     If ESC = true then goto Lin2
  485.     GetCoord  "LINEAR ARRAY -- Vector between copies",dX#,dY#,dZ#,ESC%
  486.     If ESC = true then GOTO Lin1
  487.  
  488. WITHOBJECT "CorelCAD.Automation.1"
  489.     .LinearArray DoOverall,NumCopies,0,0,0,dX,dY,dZ
  490. END WITHOBJECT
  491.  
  492. Lin2:
  493. END SUB    'LinearArr    
  494. '*************************************************************************************
  495. SUB TwoDArr (DoOverall%,ESC%)
  496.  
  497. DIM NumCop1#,NumCop2#
  498. DIM NumCopies1&,NumCopies2&
  499. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  500.  
  501. TWO1:
  502.     GetValue   "2D ARRAY -- # of copies in 1st direction",NumCop1#,ESC%
  503.     NumCopies1=cint(NumCop1)
  504.     If ESC = true then GOTO TWO4
  505. TWO2:
  506.     GetValue  "2D ARRAY -- # of copies in 2nd direction",NumCop2#,ESC%
  507.     NumCopies2=cint(NumCop2)
  508.     If ESC = true then GOTO TWO1 
  509. TWO3:    
  510.     GetCoord  "2D ARRAY -- Vector between copies (Dir 1)",X1#,Y1#,Z1#,ESC%
  511.     If ESC = true then GOTO TWO2
  512.  
  513.     GetCoord  "2D ARRAY -- Vector between copies (Dir 2)",X2#,Y2#,Z2#,ESC%
  514.      If ESC = true then GOTO TWO3    
  515.  
  516. WITHOBJECT "CorelCAD.Automation.1"
  517.     .TwoDArray DoOverall,NumCopies1,NumCopies2,0,0,0,X1,Y1,Z1,X2,Y2,Z2
  518. END WITHOBJECT
  519.  
  520. TWO4:
  521. END SUB      'TwoDArr
  522. '*************************************************************************************
  523. SUB ThreeDArr (DoOverall%,ESC%)
  524.  
  525. DIM NumCop1#,NumCop2#,NumCop3#
  526. DIM NumCopies1&,NumCopies2&,NumCopies3&
  527. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  528.  
  529. THREED1:
  530.     GetValue  "3D ARRAY -- # of copies in 1st direction",NumCop1#,ESC%
  531.     NumCopies1=cint(NumCop1)
  532.     If ESC = true then GOTO THREED6
  533. THREED2:
  534.     GetValue "3D ARRAY -- # of copies in 2nd direction",NumCop2#,ESC%
  535.     NumCopies2=cint(NumCop2)
  536.     If ESC = true then GOTO THREED1 
  537. THREED3:
  538.     GetValue  "3D ARRAY -- # of copies in 3rd direction",NumCop3#,ESC%
  539.     NumCopies3=cint(NumCop3)
  540.     If ESC = true then GOTO THREED2
  541. THREED4:
  542.     GetCoord  "3D ARRAY -- Vector between copies (Dir 1)",X1#,Y1#,Z1#,ESC%
  543.     If ESC = true then GOTO THREED3
  544. THREED5:
  545.     GetCoord  "3D ARRAY -- Vector between copies (Dir 2)",X2#,Y2#,Z2#,ESC%
  546.     If ESC = true then GOTO THREED4
  547.  
  548.     GetCoord  "3D ARRAY -- Vector between copies (Dir 3)",X3#,Y3#,Z3#,ESC%
  549.      If ESC = true then GOTO THREED5
  550.     
  551.  
  552. WITHOBJECT "CorelCAD.Automation.1"
  553.     .ThreeDArray DoOverall,NumCopies1,NumCopies2,NumCopies3,0,0,0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  554. END WITHOBJECT
  555.  
  556. THREED6:
  557. END SUB    'ThreeDArr
  558. '*************************************************************************************
  559. SUB CircleArr(ESC%)
  560.  
  561. DIM NumCop#
  562. DIM NumCopies%
  563. DIM RotateLet$
  564. DIM Rotate%
  565. DIM Angle#
  566.  
  567.     Rotate% = 0
  568. CIR1:
  569.     GetLetter "CIRCULAR ARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  570.     If ESC = True then goto CIR8
  571. CIR2:
  572.     GetValue "CIRCULAR ARRAY -- # of copies  ",NumCop#,ESC%
  573.     NumCopies=CINT(NumCop)
  574.     If ESC = True then goto CIR1
  575. CIR3:
  576.     GetValue "CIRCULAR ARRAY -- Angle of rotation",Angle#,ESC%
  577.     If ESC = True then goto CIR2
  578. WITHOBJECT "CorelCAD.Automation.1"
  579.     If RotateLet="Y" then
  580.         Rotate=-1
  581. CIR4:
  582.         GetCoord  "CIRCULAR ARRAY -- Start Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  583.     If ESC = True then goto CIR3
  584.         x2=x1
  585.         y2=y1
  586.         z2=z1
  587. CIR5:
  588.         GetCoord  "CIRCULAR ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  589.     If ESC = True then goto CIR4
  590.         .CircularArray NumCopies%,Angle#,Rotate%,X1,y1,z1,x2,y2,z2
  591.     else
  592.         Rotate=0
  593. CIR6:
  594.         GetCoord  "CIRCULAR ARRAY --Base Point for rotation",X1#,Y1#,Z1#,ESC%
  595.     If ESC = True then goto CIR3
  596.         x2=x1
  597.         y2=y1
  598.         z2=z1
  599. CIR7:
  600.         GetCoord  "CIRCULAR ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  601.     If ESC = True then goto CIR6
  602.         x3=x2
  603.         y3=y2
  604.         z3=z2
  605.  
  606.         GetCoord "CIRCULAR ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  607.     If ESC = True then goto CIR7
  608.         .CircularArray NumCopies%,Angle#,Rotate%,X1,y1,z1,x2,y2,z2,x3,y3,z3
  609.     END IF
  610. END WITHOBJECT
  611.  
  612. CIR8:
  613. END SUB    'CircleArr
  614. '*************************************************************************************
  615. SUB SpiralArr(ESC%)
  616.  
  617. DIM NumCop#
  618. DIM NumCopies%
  619. DIM RotateLet$
  620. DIM Rotate%
  621. DIM Angle#
  622. DIM Offset#
  623. DIM x1#,y1#,z1#,x2#,y2#,z2#,x3#,y3#,z3#
  624.  
  625.     Rotate% = 0
  626. SPI1:
  627.     GetLetter "SPIRAL ARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  628.     If ESC = True then goto SPI9
  629. SPI2:
  630.     GetValue "SPIRAL ARRAY -- # of copies  ",NumCop#,ESC%
  631.     NumCopies=CINT(NumCop)
  632.     If ESC = True then goto SPI1
  633. SPI3:
  634.     GetValue  "SPIRAL ARRAY -- Angle of rotation",Angle#,ESC%
  635.     If ESC = True then goto SPI2
  636.     Angle#=Angle/360
  637. SPI4:
  638.     GetValue "SPIRAL ARRAY -- Magnitude of offset",Offset#,ESC%
  639.     If ESC = True then goto SPI3
  640.  
  641. WITHOBJECT "CorelCAD.Automation.1"
  642.     If RotateLet="Y" then
  643.         Rotate=-1
  644. SPI5:
  645.         GetCoord  "SPIRAL ARRAY -- First Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  646.     If ESC = True then goto SPI4
  647.         x2#=x1#
  648.         y2#=y1#
  649.         z2#=z1#
  650. SPI6:
  651.         GetCoord  "SPIRAL ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  652.     If ESC = True then goto SPI5
  653.         .SpiralArray NumCopies%,Angle#,Offset#,Rotate%,X1,y1,z1,x2,y2,z2
  654.     else
  655.         Rotate=0
  656. SPI7:
  657.         GetCoord  "SPIRAL ARRAY -- Base Point for rotation",X1#,Y1#,Z1#,ESC%
  658.     If ESC = True then goto SPI4
  659.         x2=x1
  660.         y2=y1
  661.         z2=z1
  662. SPI8:
  663.         GetCoord "SPIRAL ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  664.     If ESC = True then goto SPI5
  665.         x3=x2
  666.         y3=y2
  667.         z3=z2
  668.  
  669.         GetCoord "SPIRAL ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  670.          If ESC = True then goto SPI6
  671.         .SpiralArray NumCopies%,Angle#,Offset#,Rotate%,X1,y1,z1,x2,y2,z2,x3,y3,z3
  672.     END IF
  673. END WITHOBJECT
  674.  
  675. SPI9:
  676. END SUB    'SpiralArr
  677. '*************************************************************************************
  678. SUB SphereArr(ESC%)
  679.     
  680. DIM Numeq#, Numpo#,Row#
  681. DIM Numequator%,Numpoles%,Rows%
  682. DIM Rotateobject$
  683. DIM Rotate%
  684.  
  685. DIM x1#,y1#,z1#,x2#,y2#,z2#,x3#,y3#,z3#
  686.  
  687.     Rotate% = 0
  688. SPH1:
  689.     GetLetter "SPhereARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  690.     If ESC = True then goto SPH9
  691. SPH2:
  692.     GetValue "SPere ARRAY -- # of copies  in equator ",Numeq#,ESC%
  693.     Numequator=CINT(Numeq)
  694.     If ESC = True then goto SPH1
  695. SPH3:
  696.     GetValue  "SPere ARRAY -- # of copies in poles",Numpo#,ESC%
  697.     Numpoles=CINT(Numpo)
  698.      If ESC = True then goto SPH2
  699.     
  700. SPH4:
  701.     GetValue "SPere ARRAY -- # of rows",Row#,ESC%
  702.      Rows=CINT(Row) 
  703.      If ESC = True then goto SPH3
  704.  
  705. WITHOBJECT "CorelCAD.Automation.1"
  706.     If RotateLet="Y" then
  707.         Rotate=-1
  708. SPH5:
  709.         GetCoord  "Spere ARRAY -- First Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  710.          If ESC = True then goto SPH4
  711.         x2#=x1#
  712.         y2#=y1#
  713.         z2#=z1#
  714. SPH6:
  715.         GetCoord  "SPere ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  716.          If ESC = True then goto SPH5
  717.           GetCoord  "SPere ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  718.         .SphericalArray  Numequator%,numpoles,rows,Rotate%,X1,y1,z1,x2,y2,z2,X3,Y3,Z3
  719.     else
  720.         Rotate=0
  721. SPH7:
  722.         GetCoord  "SPere ARRAY -- Base Point for rotation",X1#,Y1#,Z1#,ESC%
  723.     If ESC = True then goto SPH4
  724.         x2=x1
  725.         y2=y1
  726.         z2=z1
  727. SPH8:
  728.         GetCoord "SPere ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  729.     If ESC = True then goto SPH5
  730.         x3=x2
  731.         y3=y2
  732.         z3=z2
  733.  
  734.         GetCoord "SPere ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  735.          If ESC = True then goto SPh6
  736.      .SphericalArray  Numequator%,numpoles,rows,Rotate%,X1,y1,z1,x2,y2,z2,X3,Y3,Z3    
  737.     END IF
  738. END WITHOBJECT
  739.  
  740. SPH9:
  741. END SUB    'SphereArr
  742.  
  743. '*************************************************************************************
  744. '***************************       START ARCS     ************************************
  745. '*************************************************************************************
  746. SUB CreateArc
  747.  
  748. DIM Wireflag%
  749. DIM ArcType$
  750.  
  751. ARC1:
  752.     GetLetter "ARC -- Options","(W)ire, (C)enter, (E)ndpoint:","WCE",ArcType$,ESC%
  753.     If ESC = True then goto ARC2
  754.  
  755.     SELECT CASE ArcType$
  756.         CASE "W"
  757.             WireFlag% = 0        
  758.         CASE "C"
  759.             WireFlag% = 1
  760.         CASE "E"
  761.             WireFlag% = 2    
  762.     END SELECT
  763.  
  764.  
  765. DiaAr:
  766.  
  767.     TypeArc = "3"
  768.     BEGIN DIALOG DiaArc 47, 372, 254, 16, "ARC -- Define your Arc"
  769.         TEXT  0, 4, 197, 12, "(3)Pt,(A)ngle,(C)tr,(R)adius,(E)llipse:"
  770.         TEXTBOX  111, 2, 55, 13, TypeArc$
  771.         OKBUTTON  170, 1, 40, 15
  772.         CANCELBUTTON  214, 1, 40, 15
  773.     END DIALOG
  774.  
  775.     ret= DIALOG(DiaArc)
  776.     if ret = 2 then goto ARC1
  777.     TypeArc$=UCASE(TypeArc$)
  778.  
  779.     SELECT CASE TypeArc$
  780.         CASE "3"
  781.                 CreateArc3Points Wireflag%,ESC%
  782.         CASE "A"
  783.                 CreateArcAngle Wireflag%,ESC%
  784.         CASE "C"
  785.                 CreateArcCSE Wireflag%,ESC%
  786.         CASE "E"
  787.                 CreateArcEllipses Wireflag%,ESC%
  788.         CASE "R"
  789.                 CreateArcRSE Wireflag%,ESC%
  790.         CASE else
  791.                 Message "Sorry, not a correct entry. Pick an character in brackets "
  792.                 goto DiaAr    
  793.     END SELECT
  794. '     --  --  --  --  -- -        
  795.  
  796. ARC2:
  797. END SUB
  798.  
  799. '*************************************************************************************
  800. SUB CreateArc3Points (Wireflag%,ESC%)
  801.  
  802. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  803.   ARC31:
  804.      ESC=false  
  805.     GetCoord  "ARC -- Pick start point",X1#,Y1#,Z1#,ESC%
  806.      if ESC=true then goto ARC33 
  807.     x2=x1
  808.     y2=y1
  809.     z2=z1
  810. ARC32: 
  811.      ESC=false
  812.      GetCoord  "ARC -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  813.      if ESC=true then goto ARC31
  814.     x3=x2
  815.     y3=y2
  816.     z3=z2
  817.  
  818.      ESC=false
  819.     GetCoord  "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  820.       if ESC=true then goto ARC32
  821. WITHOBJECT "CorelCAD.Automation.1"
  822.     .Arc3Points WireFlag, X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  823. END WITHOBJECT
  824. ARC33:
  825. END SUB 'CreateArc3Points
  826. '*************************************************************************************
  827. SUB CreateArcAngle (WireFlag%,ESC%)
  828.  
  829. DIM Angle#    
  830. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  831.  ARCANGLE1:
  832.      ESC=false
  833.     GetValue  "ARC -- Enter the Arc Angle",Angle#,ESC%
  834.      if ESC=true then goto ARCANGLE3 
  835. ARCANGLE2:
  836.      ESC=false 
  837.      GetCoord  "ARC -- Pick start point", X1#, Y1#, Z1#,ESC%
  838.     if ESC=true then goto ARCANGLE1
  839.      x2=x1
  840.     y2=y1
  841.     z2=z1
  842.  
  843.      ESC=false
  844.       GetCoord "ARC -- Pick end point", X2#, Y2#, Z2#,ESC%
  845.      if ESC=true then goto ARCANGLE2
  846.  
  847. WITHOBJECT "CorelCAD.Automation.1"
  848.     .ArcAngle WireFlag, Angle, X1, Y1, Z1, X2, Y2, Z2
  849. END WITHOBJECT
  850. ARCANGLE3:
  851. END SUB 'CreateArcAngle
  852. '*************************************************************************************
  853. SUB CreateArcCSE (WireFlag%,ESC%)
  854.  
  855.     DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  856. ARCCSE1:
  857.      ESC=false
  858.       GetCoord  "ARC -- Pick center of the arc",X1#,Y1#,Z1#,ESC%
  859.      if ESC=true then goto ARCCSE3
  860.     x2=x1
  861.     y2=y1
  862.     y2=y1
  863. ARCCSE2:
  864.      ESC=false 
  865.      GetCoord  "ARC -- Pick start point",X2#,Y2#,Z2#,ESC%
  866.       if ESC=true then goto ARCCSE1
  867.     x3=x2
  868.     y3=y2
  869.     z3=z2
  870.  
  871.      ESC=false
  872.     GetCoord "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  873.       if ESC=true then goto ARCCSE2
  874. WITHOBJECT "CorelCAD.Automation.1"
  875.     .ArcCSE WireFlag, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  876. END WITHOBJECT
  877. ARCCSE3:
  878.      
  879. END SUB 'CreateArcCSE
  880. '*************************************************************************************
  881. SUB CreateArcEllipses (WireFlag%,ESC%)
  882.  
  883. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,X5#,Y5#,Z5#
  884. ARCELLIPSE1:
  885.      ESC=false
  886.       GetCoord "ARC -- Pick center of ellipse",X1#,Y1#,Z1#,ESC%
  887.      if ESC=true then goto ARCELLIPSE5
  888.      ESC=false
  889.     x2=x1
  890.     y2=y1
  891.     z2=y1
  892. ARCELLIPSE2:
  893.      ESC=false 
  894.      GetCoord "ARC -- Pick 2nd point (defines major axis)",X2#,Y2#,Z2#,ESC%
  895.       if ESC=true then goto ARCELLIPSE1
  896.     x3=x2
  897.     y3=y2
  898.     z3=y2
  899. ARCELLIPSE3:
  900.      ESC=false
  901.     GetCoord  "ARC -- Pick 3rd point (defines minor axis)",X3#,Y3#,Z3#,ESC%
  902.       if ESC=true then goto ARCELLIPSE2
  903.     x4=x3
  904.     y4=y3
  905.     z4=y3
  906. ARCELLIPSE4:
  907.      ESC=false
  908.       GetCoord "ARC -- Pick 4th point (defines start angle)",X4#,Y4#,Z4#,ESC%
  909.       if ESC=true then goto ARCELLIPSE3 
  910.     x5=x4
  911.     y5=y4
  912.     z5=y4
  913.  
  914.      ESC=false
  915.     GetCoord "ARC -- Pick 5th point (defines stop angle)",X5#,Y5#,Z5#,ESC%
  916.       if ESC=true then goto ARCELLIPSE4
  917. WITHOBJECT "CorelCAD.Automation.1"
  918.     .ArcEllipse WireFlag, X1, Y1, Z1, X1+X2, Y1+Y2, Z1+Z2, X1+X3, Y1+Y3, Z1+Z3, X4, Y4, Z4, X5, Y5, Z5
  919. END WITHOBJECT
  920. ARCELLIPSE5:
  921.      
  922. END SUB 'CreateArcEllipses
  923. '*************************************************************************************
  924. SUB CreateArcRSE (WireFlag%,ESC%)
  925.  
  926. DIM RAD as double
  927. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  928. ARCRSE1:
  929.      ESC=false
  930.     GetValue "ARC -- Enter the radius of the arc",Rad#,ESC%
  931.      if ESC=true then goto ARCRSE4
  932. ARCRSE2:
  933.      ESC=false 
  934.      GetCoord "ARC -- Pick start point",X1#,Y1#,Z1#,ESC%
  935.      if ESC=true then goto ARCRSE1
  936.     x2=x1
  937.     y2=y1
  938.     z2=y1
  939. ARCRSE3:
  940.      ESC=false
  941.     GetCoord "ARC -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  942.      if ESC=true then goto ARCRSE2
  943.     x3=x2
  944.     y3=y2
  945.     z3=y2
  946.  
  947.      ESC=false
  948.     GetCoord "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  949.      if ESC=true then goto ARCRSE3
  950. WITHOBJECT "CorelCAD.Automation.1"
  951.     .ArcRSE WireFlag, RAD, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  952. END WITHOBJECT
  953. ARCRSE4:
  954.      
  955. END SUB 'CreateArcRSE
  956. '*************************************************************************************
  957. '*************************      END   ARCS     ***************************************
  958. '*************************************************************************************
  959. SUB CreateBox
  960.  
  961.  
  962. DIM X1#,Y1#,Z1#,dX#,dY#,dZ#,ESC%
  963. DIM SolidLet$
  964. DIM WireFlag%
  965. BOX1:
  966.    ESC=false    
  967.     GetLetter "BOX -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  968.      if ESC=true then goto BOX5
  969.     SELECT CASE SolidLet$
  970.         CASE "U"
  971.             WireFlag% = 0        
  972.         CASE "S"
  973.             WireFlag% = 1
  974.     END SELECT
  975. BOX2:
  976.      ESC=false
  977.     GetCoord "BOX -- Pick start point",X1#,Y1#,Z1#,ESC%
  978.       if ESC=true then goto BOX1
  979. BOX3:
  980.     ESC=false
  981.    
  982.     GetValue "BOX -- Enter the width (X-Direction)",dX,ESC%
  983.       if ESC=true then goto BOX2
  984. BOX4:
  985.      ESC=false
  986.     GetValue "BOX -- Enter the length (Y-Direction)",dY,ESC%
  987.       if ESC=true then goto BOX3
  988.  
  989.      GetValue "BOX -- Enter the height (Z-Direction)",dZ,ESC%
  990.       if ESC=true then goto BOX4
  991. WITHOBJECT "CorelCAD.Automation.1"
  992.     .box WireFlag, X1,Y1,Z1,X1+dX,Y1+DY,Z1+dZ
  993. END WITHOBJECT 
  994. BOX5:
  995. donebox: 
  996. END SUB 'CreateBox
  997. '*************************************************************************************
  998. '*************************    START CIRCLES     **************************************
  999. '*************************************************************************************
  1000. SUB CreateCircle
  1001.  
  1002.  
  1003. DIM WireFlag%
  1004. DIM CircType$
  1005. DIM TypeCircle$
  1006. DIM ESC%
  1007. CIRCLE1:
  1008.      ESC=false     
  1009.     GetLetter "CIRCLE -- Options","(W)ireframe, (S)urface:","WS", CircType$,ESC%
  1010.      if ESC=true then goto CIRCLE2
  1011.     SELECT CASE CircType$
  1012.         CASE "W"
  1013.             WireFlag% = 0        
  1014.         CASE "S","s"
  1015.             WireFlag% = 1
  1016.     END SELECT
  1017.  
  1018.           
  1019.     GetLetter "CIRCLE -- Type","(C)enter,(2)Point,(3)Point: ","C23",TypeCircle$,ESC%
  1020.      if ESC=true then goto CIRCLE1
  1021.     SELECT CASE TypeCircle$
  1022.         CASE "C"
  1023.                 CreateCircleRadius WireFlag%,ESC%
  1024.                 If ESC = TRUE then Goto CIRCLE2    
  1025.         CASE "2"
  1026.                 CreateCircleDiameter WireFlag%,ESC%
  1027.                 If ESC = TRUE then Goto CIRCLE2                        
  1028.         CASE "3"
  1029.                 CreateCircle3Point WireFlag%,ESC%
  1030.                 If ESC = TRUE then Goto CIRCLE2    
  1031.     END SELECT
  1032. CIRCLE2:
  1033.      
  1034. END SUB
  1035. '*************************************************************************************
  1036. SUB CreateCircle3Point(WireFlag%,ESC%)
  1037.  
  1038. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  1039. CIRCLE31:
  1040.      ESC=false
  1041.       GetCoord  "CIRCLE -- Pick 1st point",X1#,Y1#,Z1#,ESC%
  1042.      if ESC=true then goto CIRCLE33
  1043.     x2=x1
  1044.     y2=y1
  1045.     z2=y1
  1046. CIRCLE32:
  1047.      ESC=false
  1048.       GetCoord "CIRCLE -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  1049.        if ESC=true then goto CIRCLE31
  1050.     x3=x2
  1051.     y3=y2
  1052.     z3=y2
  1053.  
  1054.  
  1055.      ESC=false
  1056.     GetCoord "CIRCLE -- Pick 3rd point",X3#,Y3#,Z3#,ESC%
  1057.        if ESC=true then goto CIRCLE32
  1058. WITHOBJECT "CorelCAD.Automation.1"
  1059.     .Circle3Points WireFlag, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  1060. END WITHOBJECT
  1061. CIRCLE33:
  1062.      
  1063. END SUB 'CreateCircle3Point
  1064. '*************************************************************************************
  1065. SUB CreateCircleDiameter(WireFlag%,ESC%)
  1066.  
  1067. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  1068. CIRCLED1:
  1069.      ESC=false
  1070.       GetCoord  "CIRCLE -- Pick 1st point", X#, Y#, Z#,ESC%
  1071.      if ESC=true then goto CIRCLED2
  1072.      X2=x
  1073.     Y2=y
  1074.     Z2=z
  1075.  
  1076.      ESC=false 
  1077.      GetCoord "CIRCLE -- Pick 2nd point (defines diameter)", X2#, Y2#, Z2#,ESC%
  1078.      if ESC=true then goto CIRCLED1
  1079.  
  1080. WITHOBJECT "CorelCAD.Automation.1"
  1081.     .CircleDiameter  WireFlag, X1, Y1, Z1, X2, Y2, Z2
  1082. END WITHOBJECT
  1083. CIRCLED2:
  1084.      
  1085. END SUB 'CreateCircleDiameter
  1086. '*************************************************************************************
  1087. SUB CreateCircleRadius(WireFlag%,ESC%)                    ' THIS FUNCTION ASSUMES THE USER WANTS A CIRCLE IN THE
  1088.                                             ' X-Y PLANE, AND HE IS NOT ABLE TO DRAW ONE WITH ANY
  1089. DIM X1#,Y1#,Z1#                                ' DIMENSION IN THE Z DIRECTION (this is easily changed if desired)
  1090. DIM dX as double        'this could be changed to declare x2, y2, z2                            
  1091. CircleRadius1:
  1092.      ESC=false                
  1093.       GetCoord "CIRCLE -- Pick center of the circle",X1#,Y1#,Z1#,ESC%
  1094.      if ESC=true then goto CircleRadius2
  1095.  
  1096.      ESC=false    
  1097.     GetValue  "CIRCLE -- Enter the radius",dX,ESC%                    'this could be changed to pick point (x2,y2,z2)
  1098.        if ESC=true then goto CircleRadius1
  1099.  
  1100. WITHOBJECT "CorelCAD.Automation.1"
  1101.     .CircleRadius  WireFlag, X1,Y1,Z1,X1+dX,Y1,Z1
  1102. END WITHOBJECT
  1103. CircleRadius2:
  1104.      
  1105. END SUB 'CreateCircleRadius
  1106. '*************************************************************************************
  1107. '**************************     END CIRCLES   ****************************************
  1108. '*************************************************************************************
  1109. SUB CreateCone
  1110.  
  1111. DIM X1#,Y1#,Z1#,ESC%
  1112. DIM dX#      'for the radius
  1113. DIM dZ#    'for the height
  1114. DIM SolidLet$
  1115. DIM WireFlag%
  1116. CONE1:
  1117.      ESC=false    
  1118.     GetLetter "CONE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1119.      if ESC=true then goto CONE4
  1120.     SELECT CASE SolidLet$
  1121.         CASE "U"
  1122.             WireFlag% = 0        
  1123.         CASE "S"
  1124.             WireFlag% = 1
  1125.     END SELECT
  1126. CONE2:
  1127.      ESC=false
  1128.     GetCoord  "CONE -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1129.       if ESC=true then goto CONE1
  1130. CONE3:
  1131.      ESC=false
  1132.     GetValue "CONE -- Enter the radius of the face", dX#,ESC%            'assumes face is in the x-y plane
  1133.       if ESC=true then goto CONE2
  1134.  
  1135.      ESC=false
  1136.     GetValue "CONE -- Enter the height of the cone",dZ#,ESC%        'assumes height is along z-axis
  1137.       if ESC=true then goto CONE3
  1138. WITHOBJECT "CorelCAD.Automation.1"
  1139.     .Cone WireFlag,X1,Y1,Z1,X1+dX,Y1,Z1,X1,Y1,Z1+dZ
  1140. END WITHOBJECT
  1141. CONE4:
  1142. END SUB 'CreateCones
  1143. '*************************************************************************************
  1144. SUB CreateCylinder
  1145.  
  1146. DIM X1#,Y1#,Z1#,ESC%
  1147. DIM dX#      'for the radius
  1148. DIM dZ#    'for the height
  1149. DIM SolidLet$
  1150. DIM WireFlag%
  1151.  
  1152. CYLINDER1:
  1153.      ESC=false
  1154.     GetLetter "CYLINDER -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1155.      if ESC=true then goto CYLINDER4
  1156.     SELECT CASE SolidLet$
  1157.         CASE "U"
  1158.             WireFlag% = 0        
  1159.         CASE "S"
  1160.             WireFlag% = 1
  1161.     END SELECT
  1162. CYLINDER2:
  1163.      ESC=false
  1164.     GetCoord  "CYLINDER -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1165.      if ESC=true then goto CYLINDER1
  1166. CYLINDER3:
  1167.      ESC=false
  1168.     GetValue "CYLINDER -- Enter the radius of the face", dX#,ESC%            'assumes face is in the x-y plane
  1169.      if ESC=true then goto CYLINDER2
  1170.  
  1171.      ESC=false
  1172.        GetValue  "CYLINDER -- Enter the height of the cylinder",dZ#,ESC%        'assumes height is along z-axis
  1173.      if ESC=true then goto CYLINDER3 
  1174. WITHOBJECT "CorelCAD.Automation.1"
  1175.     .Cylinder WireFlag,X1,Y1,Z1,X1+dX,Y1,Z1,X1,Y1,Z1+dZ
  1176. END WITHOBJECT
  1177. CYLINDER4:
  1178.      
  1179. END SUB 'CreateCylinder
  1180. '*************************************************************************************
  1181. SUB CreateEllipse
  1182.     
  1183. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1184. DIM EllType$
  1185. ELLIPSE1:
  1186.      ESC=false
  1187.        GetLetter "ELLIPSE -- Options","(W)ireframe, (S)urface:","WS", EllType$,ESC%
  1188.      if ESC=true then goto ELLIPSE4
  1189.     SELECT CASE EllType$
  1190.         CASE "W"
  1191.             WireFlag% = 0        
  1192.         CASE "S","s"
  1193.             WireFlag% = 1
  1194.     END SELECT
  1195.  
  1196. ELLIPSE2:
  1197.      ESC=false    
  1198.      GetCoord "ELLIPSE -- Pick center",X1#,Y1#,Z1#,ESC%
  1199.      if ESC=false then goto ELLIPSE1 
  1200.      x2=x1
  1201.     y2=y1
  1202.     z2=y1
  1203. ELLIPSE3:
  1204.      ESC=false
  1205.     GetCoord  "ELLIPSE -- Pick 2nd point (defines major axis)",X2#,Y2#,Z2#,ESC%
  1206.       if ESC=false then goto ELLIPSE2 
  1207.     x3=x2
  1208.     y3=y2
  1209.     z3=y2
  1210.  
  1211.      ESC=false
  1212.     GetCoord  "ELLIPSE -- Pick 3rd point (defines minor axis)",X3#,Y3#,Z3#,ESC%
  1213.       if ESC=false then goto ELLIPSE3
  1214. WITHOBJECT "CorelCAD.Automation.1"
  1215.     .Ellipse WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  1216. END WITHOBJECT
  1217. ELLIPSE4:
  1218. donell: 
  1219. END SUB 'CreateEllipse
  1220. '*************************************************************************************
  1221. SUB CreateFrustum
  1222.  
  1223. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,X5#,Y5#,Z5#,ESC%
  1224. DIM SolidLet$
  1225. DIM WireFlag%
  1226. FRUSTUM1:
  1227.      ESC=false
  1228.     GetLetter "FRUSTUM -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1229.      if ESC=true then goto FRUSTUM6
  1230.     SELECT CASE SolidLet$
  1231.         CASE "U"
  1232.             WireFlag% = 0        
  1233.         CASE "S"
  1234.             WireFlag% = 1
  1235.     END SELECT
  1236. FRUSTUM2:
  1237.      ESC=false
  1238.     GetCoord  "FRUSTUM -- Pick center of the base",X1#,Y1#,Z1#,ESC%
  1239.      if ESC=true then goto FRUSTUM1
  1240.     x2=x1
  1241.     y2=y1
  1242.     z2=y1
  1243. FRUSTUM3:
  1244.      ESC=false
  1245.     GetCoord  "FRUSTUM -- Pick 2nd point (defines radius of base)",X2#,Y2#,Z2#,ESC%
  1246.     if ESC=true then goto FRUSTUM2
  1247.      x3=x2
  1248.     y3=y2
  1249.     z3=y2
  1250. FRUSTUM4:
  1251.      ESC=false
  1252.     GetCoord "FRUSTUM -- Pick 3rd point (defines center of second face)",X3#,Y3#,Z3#,ESC%
  1253.     if ESC=true then goto FRUSTUM3
  1254.      x4=x3
  1255.     y4=y3
  1256.     z4=y3
  1257. FRUSTUM5:
  1258.      ESC=false
  1259.     GetCoord  "FRUSTUM -- Pick 4th point (defines radius of second face)",X4#,Y4#,Z4#,ESC%
  1260.     if ESC=true then goto FRUSTUM4
  1261.      x5=x4
  1262.     y5=y4
  1263.     z5=y4
  1264.  
  1265.      ESC=false
  1266.     
  1267. WITHOBJECT "CorelCAD.Automation.1"
  1268.     .Frustum WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4
  1269. END WITHOBJECT
  1270. FRUSTUM6:
  1271.      
  1272.  
  1273. END SUB 'CreateFrustum
  1274. '*************************************************************************************
  1275. SUB CreateHemisphere
  1276.  
  1277. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1278. DIM SolidLet$
  1279. DIM WireFlag%
  1280. HEMISPHERE1:
  1281.      ESC=false    
  1282.     GetLetter "HEMISPHERE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1283.      if ESC=true then goto Hemisphere4    
  1284.     SELECT CASE SolidLet$
  1285.         CASE "U"
  1286.             WireFlag% = 0        
  1287.         CASE "S"
  1288.             WireFlag% = 1
  1289.     END SELECT
  1290. HEMISPHERE2:
  1291.      ESC=false    
  1292.     GetCoord  "HEMISPHERE -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1293.      if ESC=true then goto HEMISPHERE1 
  1294.     x2=x1
  1295.     y2=y1
  1296.     z2=y1
  1297. HEMISPHERE3:
  1298.      ESC=false    
  1299.     GetCoord  "HEMISPHERE -- Pick 2nd point (defines radius)",X2#,Y2#,Z2#,ESC%
  1300.     if ESC=true then goto HEMISPHERE2
  1301.      x3=x2
  1302.     y3=y2
  1303.     z3=y2
  1304.  
  1305.      ESC=false    
  1306.     GetCoord  "HEMISPHERE -- Pick 3rd point (defines direction of bowl)",X3#,Y3#,Z3#,ESC%
  1307.      if ESC=true then goto HEMISPHERE3
  1308. WITHOBJECT "CorelCAD.Automation.1"
  1309.     .HemiSphere WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  1310. END WITHOBJECT
  1311. HEMISPHERE4:
  1312.      
  1313. donehem: 
  1314. END SUB 'CreateHemisphere
  1315. '*************************************************************************************
  1316. SUB CreateLine (PolyFlag%)
  1317.  
  1318. DIM i%                'counter
  1319. DIM NumPoints%
  1320. DIM StrArray$(10)
  1321. DIM x#,y#,z#,ESC%
  1322. DIM Points#(100,3)
  1323. DIM EntryStr$
  1324.  
  1325.     EntryStr$= "POLYLINE -- Pick starting point"
  1326.     If (PolyFlag%=FALSE) then EntryStr$= "LINE SEGMENTS -- Pick starting point"
  1327.  
  1328.     GetCoord  EntryStr$, x#,y#,z#,ESC%
  1329.     If ESC = TRUE then Goto AllDone
  1330.  
  1331.     Points#(1,1)= x
  1332.     Points#(1,2)= y
  1333.     Points#(1,3)= z
  1334.  
  1335.     FOR i%=2 to 100
  1336.         oops:
  1337.         temp$=LTRIM(str(i))    
  1338.  
  1339.      ESC=false
  1340.         GetCoord  temp$, x#, y#, z#,ESC%
  1341.  
  1342.         IF temp$="C" then
  1343.             Points#(i,1)=Points#(1,1)
  1344.             Points#(i,2)=Points#(1,2)
  1345.             Points#(i,3)=Points#(1,3)
  1346.             goto DoneFor
  1347.         ELSEIF temp$="D" then
  1348.             i%=i-1
  1349.             goto DoneFor
  1350.         ELSEIF temp$="E" then
  1351.             goto Edit
  1352.         ELSE
  1353.             Points#(i,1)=x
  1354.             Points#(i,2)=y
  1355.             Points#(i,3)=z
  1356.         ENDIF
  1357.     NEXT I%
  1358.  
  1359. DoneFor:
  1360.  
  1361. WITHOBJECT "CorelCad.Automation.1"
  1362.     NumPoints%=i%
  1363.     FOR i%=1 to NumPoints
  1364.         .SetPointXYZ Points#(i,1), Points#(i,2), Points#(i,3)
  1365.     NEXT i%
  1366.     IF (PolyFlag = TRUE) THEN
  1367.             .PolyLine
  1368.         ELSE
  1369.             .LineSegment
  1370.     ENDIF
  1371.     goto alldone    
  1372. END WITHOBJECT
  1373.  
  1374. EDIT:
  1375.     NumPoints%=i-1
  1376.     
  1377.     FOR i%=1 to NumPoints
  1378.         x#=Points(i,1)
  1379.         y#=Points(i,2)
  1380.         z#=Points(i,3)
  1381.         StrArray$(i)= str(i)+")    ("+str(x)+","+str(y)+","+str(z)+")"
  1382.     NEXT i%
  1383.  
  1384.     BoxL%=10*NumPoints+4        'defines the length of the list box
  1385.     DiaL%=10*NumPoints+40        'defines the length of the dialogue box
  1386.  
  1387.     Default%= NumPoints
  1388.     BEGIN DIALOG EDSTR 123, DiaL, "Edit a point"
  1389.         TEXT  2, 22, 82, 9, "Pick point to edit:"
  1390.         LISTBOX  28, 36, 65, BoxL, StrArray$, Default%
  1391.         OKBUTTON  51, 4, 35, 14
  1392.         CANCELBUTTON  88, 4, 35, 14
  1393.     END DIALOG
  1394.  
  1395.     ret= DIALOG(EDSTR)
  1396.     if ret=2 then goto oops
  1397.  
  1398.     X#=Points(Default,1)
  1399.     Y#=Points(Default,2)
  1400.     Z#=Points(Default,3)
  1401.  
  1402.     GetCoord  "Enter new absolute coordinate",X#,Y#,Z#,ESC%
  1403.     Points#(Default,1)=x
  1404.     Points#(Default,2)=y
  1405.     Points#(Default,3)=z
  1406.     goto oops
  1407.  
  1408. alldone:
  1409. END SUB 'CreateLine
  1410. '*************************************************************************************
  1411. SUB CreatePolygon
  1412.  
  1413. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1414. DIM PolyChoice$
  1415. DIM numedges#
  1416. DIM numedge&
  1417. DIM wireflag%    
  1418. DIM answer$
  1419. DIM saveassurface%    
  1420.  
  1421. POL1:
  1422.      Getletter "POLYGON -- Properties","(S)urface or (W)ire?","SW",answer$,ESC% 
  1423.     If ESC = true then goto POL8
  1424. '*********
  1425.      if answer$="S" then
  1426.         saveassurface=-1
  1427.      ELSE
  1428.         saveassurface=0
  1429.     end if
  1430. '*********
  1431. POL2:    
  1432.    GetLetter "POLYGON -- Construction","Construction Type: (C)enter or (E)dge","CE",PolyChoice,ESC%
  1433.     If ESC = true then goto POL1
  1434.  
  1435. POL3:
  1436.     GetValue "POLYGON -- Number of sides:",numedges#,ESC% 
  1437.     If ESC = true then goto POL2
  1438.      numedge = cint(numedges)        
  1439.   
  1440.     IF polychoice$="C" then
  1441. POL4:
  1442.          GetCoord    "POLYGON -- Enter the center of the polygon",X1#,Y1#,Z1#,ESC%
  1443.         If ESC = true then goto POL3
  1444. POL5:
  1445.          GetCoord    "POLYGON -- Middle of an edge" ,X2#,Y2#,Z2#,ESC%    
  1446.         If ESC = true then goto POL4
  1447.     ELSE
  1448. POL6:    
  1449.           GetCoord    "POLYGON -- Enter first vertex" ,X1#,Y1#,Z1#,ESC%    
  1450.         If ESC = true then goto POL3
  1451. POL7:
  1452.         GetCoord    "POLYGON -- Enter second vertex" ,X2#,Y2#,Z2#,ESC%                
  1453.         If ESC = true then goto POL6
  1454.      END IF
  1455. message saveassurface
  1456. message numedge
  1457.  
  1458. Withobject "CorelCAD.Automation.1"
  1459.     If PolyChoice = "C" then
  1460.         .Polygoncenter saveassurface,X1,Y1,Z1,X2,Y2,Z2,numedge
  1461.     ELSE
  1462.         .Polygonedge saveassurface,X1,Y1,Z1,X2,Y2,Z2,numedge        
  1463.     END IF
  1464. end withobject
  1465.  
  1466. POL8:
  1467. END SUB
  1468. '*************************************************************************************
  1469. SUB CreateRectangle
  1470.  
  1471. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1472. DIM answer$,saveassurface%
  1473. RECTANGLE1:
  1474.                ESC=false          
  1475.                Getletter "RECTANGLE -- Properties","Save the object as a (S)urface or (W)ire?","SW",answer$,ESC% 
  1476.                if ESC=true then goto RECTANGLE4
  1477.                   if answer$="S" then
  1478.                        saveassurface=-1
  1479.                    else
  1480.                        saveassurface=0
  1481.                    endif 
  1482. RECTANGLE2:
  1483.                ESC=false         
  1484.              GetCoord    "Enter the start point of the rectangle",X1#,Y1#,Z1#,ESC%
  1485.                if ESC=true then goto RECTANGLE1
  1486. RECTANGLE3:
  1487.                ESC=false  
  1488.                GetCoord    "Enter the end point of the rectangle" ,X2#,Y2#,Z2#,ESC%    
  1489.                if ESC=true then goto RECTANGLE2 
  1490.                   
  1491. Withobject "corelcad.automation.1"
  1492.             .Rectangle saveassurface,X1,Y1,Z1,X2,Y2,Z2
  1493. end withobject
  1494.     
  1495. RECTANGLE4:
  1496. END SUB
  1497. '*************************************************************************************
  1498.  
  1499. SUB CreateSphere
  1500.  
  1501. DIM X1#
  1502. DIM Y1#
  1503. DIM Z1#
  1504. DIM ESC%
  1505. DIM Radius#
  1506. DIM SolidLet$
  1507. DIM WireFlag%
  1508. SPHERE1:
  1509.      ESC=false    
  1510.     GetLetter "SPHERE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1511.      if ESC=true then goto SPHERE3
  1512.     SELECT CASE SolidLet$
  1513.         CASE "U"
  1514.             WireFlag% = 0        
  1515.         CASE "S"
  1516.             WireFlag% = 1
  1517.     END SELECT
  1518. SPHERE2:
  1519.      ESC=false    
  1520.     GetCoord  "SPHERE -- Pick center of the sphere",X1#,Y1#,Z1#,ESC%
  1521.       if ESC=true then goto SPHERE1
  1522.  
  1523.      ESC=false    
  1524.     GetValue  "SPHERE -- Enter the radius of the sphere",Radius#,ESC%
  1525.       if ESC=true then goto SPHERE2
  1526. WITHOBJECT "CorelCAD.Automation.1"
  1527.     .Sphere WireFlag,X1,Y1,Z1,X1+Radius,Y1,Z1
  1528. END WITHOBJECT
  1529. SPHERE3:
  1530.      
  1531. END SUB 'CreateSphere
  1532. '*************************************************************************************
  1533. SUB CreateTorus
  1534.     
  1535. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,ESC%
  1536. DIM SolidLet$
  1537. DIM WireFlag%
  1538. TORUS1:
  1539.      ESC=false    
  1540.        GetLetter "TORUS -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1541.      if ESC=true then goto TORUS5
  1542.     SELECT CASE SolidLet$
  1543.         CASE "U"
  1544.             WireFlag% = 0        
  1545.         CASE "S"
  1546.             WireFlag% = 1
  1547.     END SELECT
  1548. TORUS2:
  1549.      ESC=false        
  1550.     GetCoord  "TORUS -- Pick center of the torus",X1#,Y1#,Z1#,ESC%
  1551.      if ESC=true then goto TORUS1
  1552.      x2=x1
  1553.     y2=y1
  1554.     z2=y1
  1555. TORUS3:
  1556.      ESC=false    
  1557.     GetCoord  "TORUS -- Pick 2nd point (defines center of tube)",X2#,Y2#,Z2#,ESC%
  1558.      if ESC=true then goto TORUS2
  1559.      x3=x2
  1560.     y3=y2
  1561.     z3=y2
  1562. TORUS4:
  1563.      ESC=false    
  1564.     GetCoord  "TORUS -- Pick 3rd point (defines the plane of the torus)",X3#,Y3#,Z3#,ESC%
  1565.      if ESC=true then goto TORUS3
  1566.      x4=x3
  1567.     y4=y3
  1568.     z4=y3
  1569.  
  1570.      ESC=false    
  1571.         GetCoord "TORUS -- Pick 4th point (defines the height of the torus)",X4#,Y4#,Z4#,ESC%
  1572.       if ESC=true then goto TORUS4
  1573. WITHOBJECT "CorelCAD.Automation.1"
  1574.     .Torus WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4
  1575. END WITHOBJECT
  1576. TORUS5:
  1577.      
  1578. donetor:
  1579. END SUB 'CreateTorus
  1580.  
  1581. '*************************************************************************************
  1582. '*************************************************************************************
  1583. '*************************************************************************************
  1584. '************************  MANIPULATING FUNCTIONS      *******************************
  1585. '*************************************************************************************
  1586. '*************************************************************************************
  1587. '*************************************************************************************
  1588. '*************************************************************************************
  1589. SUB GetCoord (DiaText,X#,Y#,Z#,ESC%)
  1590.  
  1591. DIM WantRel%            'boolean, if the user enters relative coords or not (@)
  1592. DIM TestPoly$,DispStr$
  1593. DIM WantAng%            'boolean, whether the user wants angular coords or not
  1594.  
  1595.     WantAng%= FALSE
  1596.     WantRel%= FALSE
  1597.     TestPoly$= DiaText
  1598.      
  1599.     DispStr$= "Enter a coordinate (x,y,z):"
  1600.  
  1601.     IF (VAL(LTRIM(TestPoly$)) > 1) AND (val(LTRIM(TestPoly$)) < 100) AND (CBOL(instr(TestPoly$,"ARRAY"))=false) then
  1602.         DispStr$= "OR: (C)lose,(D)one,(E)dit:"
  1603.         TempStr$= DiaText$
  1604.         DiaText$= "POLYINE -- Please choose point #"+TempStr$
  1605.     ENDIF
  1606.  
  1607.     
  1608. GtCoord:
  1609.     Coord$= "0,0,0"
  1610.     IF TestPoly$= "Enter new absolute coordinate" then Coord$= LTRIM(str(X))+","+LTRIM(STR(Y))+","+LTRIM(STR(z))
  1611.  
  1612.     BEGIN DIALOG PNT 47, 372, 254, 16, DiaText$
  1613.         TEXT  2, 3, 181, 13, DispStr$
  1614.         TEXTBOX  83, 2, 85, 13, Coord$
  1615.         OKBUTTON  170, 1, 40, 15
  1616.         CANCELBUTTON  214, 1, 40, 15
  1617.     END DIALOG
  1618.     
  1619.     ESC = FALSE
  1620.     ret = DIALOG (PNT)
  1621.     IF ret = 2 then 
  1622.         ESC = true
  1623.         goto done
  1624.     END IF
  1625.  
  1626.     IF (val(LTRIM(TestPoly$)) > 1) AND (val(LTRIM(TestPoly$)) < 100) then
  1627.         Coord$=UCASE (Coord$)
  1628.         SELECT CASE Coord$
  1629.             CASE "C"
  1630.                 DiaText$="C"
  1631.                 goto done
  1632.             CASE "D"
  1633.                 DiaText$="D"
  1634.                 goto done
  1635.             CASE "E"
  1636.                 DiaText$="E"
  1637.                 goto done
  1638.         END SELECT
  1639.     ENDIF
  1640.  
  1641.     Coord$=LTRIM (Coord$)
  1642.     Coord$=RTRIM (Coord$)
  1643.     IF (INSTR (Coord,"@")=1) then
  1644.          WantRel%= TRUE
  1645.         Coord$=RIGHT(Coord$,LEN(Coord$)-1) 
  1646.     ENDIF
  1647.     PosCom1%= INSTR(Coord$,",")
  1648.     PosCom2%= INSTR(Coord$,",",PosCom1+1)    
  1649.  
  1650.     If (PosCom2<>0) AND (INSTR(Coord$,",",PosCom2+1) <> 0) THEN
  1651.         goto Errror
  1652.        ELSE goto NotError
  1653.     ENDIF
  1654.  
  1655. Errror:
  1656.     BEGIN DIALOG Err 342, 94, "INCORRECT FORMAT"
  1657.         GROUPBOX  4, 36, 145, 48, "Examples of correct format"
  1658.         TEXT  71, 51, 40, 11, "1.5, 2.5, 3.5"
  1659.         TEXT  22, 49, 40, 11, "2, 3, 4"
  1660.         TEXT  31, 68, 106, 12, "1,3    (Z set to 0 as default)"
  1661.         TEXT  17, 8, 163, 8, "I'm sorry, you have entered an incorrect format. "
  1662.         TEXT  152, 24, 124, 16, "PLEASE TRY AGAIN"
  1663.         OKBUTTON  233, 47, 47, 16
  1664.         CANCELBUTTON  287, 47, 47, 16
  1665.     END DIALOG
  1666.         
  1667.     RET = DIALOG(Err)
  1668.     If RET = 2 then goto done
  1669.     Coord$="0,0,0"
  1670.     goto GtCoord
  1671. NotError:
  1672.     
  1673.     Num1$= LEFT(Coord$, PosCom1-1)
  1674.     Num2$= MID(Coord$, PosCom1+1, PosCom2-PosCom1-1)    
  1675.     Num3$= RIGHT(Coord$,LEN(Coord$)-PosCom2)
  1676.  
  1677.     If PosCom1=0 then 
  1678.             Num1$=Coord$
  1679.             Num2$="0"
  1680.             Num3$="0"
  1681.         ELSEIF PosCom2=0 then
  1682.             Num2$=RIGHT(Coord$,LEN(Coord$)-PosCom1)
  1683.             Num3$="0"    
  1684.     ENDIF
  1685.         
  1686.     Num1=LTRIM (Num1)
  1687.     Num1=RTRIM (Num1)
  1688.     Num2=LTRIM (Num2)    
  1689.     Num2=RTRIM (Num2)
  1690.     Num3=LTRIM (Num3)
  1691.     Num3=RTRIM (Num3)    
  1692.             
  1693.     If (Num1$ = "0") OR (Num1$ = "0.") OR (Num1$ = "0.0") OR (Num1$ = "0.00") then 
  1694.             X=0
  1695.         ELSEIF WantRel%=TRUE then
  1696.             X=VAL(Num1$)+X
  1697.         ELSEIF VAL(Num1$)=0 then
  1698.             goto Errror
  1699.         ELSE
  1700.             X=VAL(Num1$)                
  1701.     ENDIF
  1702.  
  1703.     If (Num2$ = "0") OR (Num2$ = "0.") OR (Num2$ = "0.0") OR (Num2$ = "0.00") then 
  1704.             Y=0
  1705.         ELSEIF WantRel%=TRUE then
  1706.             y=VAL(Num2$)+Y
  1707.         ELSEIF VAL(Num2$)=0 then
  1708.             goto Errror
  1709.         ELSE
  1710.             y=VAL(Num2$)                
  1711.     ENDIF
  1712.  
  1713.     IF (Num3$ = "0") OR (Num3$ = "0.") OR (Num3$ = "0.0") OR (Num3$ = "0.00") then 
  1714.             Z=0
  1715.         ELSEIF WantRel%=TRUE then
  1716.             Z=VAL(Num3$)+Z
  1717.         ELSEIF VAL(Num3$)=0 then
  1718.             goto Errror
  1719.         ELSE
  1720.             Z=VAL(Num3$)                
  1721.     ENDIF    
  1722.  
  1723. Done:
  1724.  
  1725. END SUB
  1726. '*************************************************************************************
  1727. SUB GetValue (DiaText,dX,ESC%)
  1728.  
  1729. DIM ArrBool%
  1730.  
  1731. Dist:
  1732. Num$="0"
  1733. ArrBool= CBOL(instr(DiaText$,"of copies"))            'will be true if this fcn is being called from an array command
  1734.  
  1735. If (ArrBool=true) then Num$="2"                'sets a new default, numcopies as being 2
  1736. If CBOL(instr(DiaText$,"of copies  "))=true then Num$=20
  1737. If CBOL(instr(DiaText$,"Arc Angle"))=true then Num$=180
  1738. If CBOL(instr(DiaText$,"Y -- Angle of"))=true then Num$=360
  1739.  
  1740.  
  1741. BEGIN DIALOG Dialog1 47, 372, 254, 16, DiaText$
  1742.     TEXT  7, 4, 144, 12, "Please enter a value:"
  1743.     TEXTBOX  76, 3, 88, 13, Num$
  1744.     OKBUTTON  170, 1, 40, 15
  1745.     CANCELBUTTON  214, 1, 40, 15
  1746. END DIALOG
  1747.  
  1748. ESC= false
  1749. ret = DIALOG(Dialog1)                
  1750. If ret=2 then ESC = true
  1751.                 
  1752. Num = LTRIM (Num)
  1753. Num = RTRIM (Num)
  1754.  
  1755. If (Num$ = "0") OR (Num$ = "0.") OR (Num$ = "0.0") OR (Num$ = "0.00") then 
  1756.             dX=0
  1757.         ELSEIF (ArrBool=True)AND(Val(Num$)-cint(val(Num$)) <>0) then        'checks if user entered integer(for array command)
  1758.             Message ("I'm sorry, but you must enter an integer. Please try again")
  1759.             goto DIST
  1760.         ELSEIF VAL(Num$)=0 then
  1761.             BEGIN DIALOG Errr 334, 75, "INCORRECT ENTRY"
  1762.                 GROUPBOX  4, 36, 145, 29, "Examples of correct format"
  1763.                 TEXT  14, 51, 40, 11, "1.5"    
  1764.                 TEXT  66, 51, 40, 11, "2"
  1765.                 TEXT  102, 51, 40, 11, "6.56677889"
  1766.                 TEXT  17, 8, 163, 8, "I'm sorry, you have entered an incorrect format. "
  1767.                 TEXT  152, 24, 124, 16, "PLEASE TRY AGAIN"
  1768.                 OKBUTTON  233, 47, 47, 16
  1769.                 CANCELBUTTON  287, 47, 47, 16
  1770.             END DIALOG
  1771.             ret = DIALOG(ERRR)                
  1772.             If ret=2 then stop
  1773.             goto DIST
  1774.         ELSE
  1775.             dX=VAL(Num$)            
  1776.     ENDIF
  1777. donedis: 
  1778.  
  1779. END SUB
  1780. '*************************************************************************************
  1781. '*************************************************************************************
  1782. SUB GetLetter(TitleText$,DiaText$,LetAvail$,LetPicked$,ESC%)
  1783.  
  1784.             ' the first character in the LetAvail string will be assigned to this variable
  1785.  
  1786.     DO 
  1787.         LetAvail = UCASE (LetAvail)
  1788.         LetPicked = LEFT (LetAvail,1)
  1789.  
  1790.         BEGIN DIALOG DiaLetter 47, 372, 254, 16, TitleText$
  1791.             TEXT  0, 4, 197, 12, DiaText$
  1792.             TEXTBOX  118, 2, 48, 13, LetPicked$
  1793.             OKBUTTON  170, 1, 40, 15
  1794.             CANCELBUTTON  212, 1, 40, 15
  1795.         END DIALOG
  1796.  
  1797.         ret=DIALOG(DiaLetter)
  1798.         If ret =2 then 
  1799.             ESC = TRUE
  1800.             goto DONELETTER
  1801.         end IF
  1802.         LetPicked=LTRIM(LetPicked)        
  1803.         LetPicked=RTRIM(LetPicked)
  1804.         LetPicked=UCASE(LetPicked)
  1805.  
  1806.         Correct= CBOL(instr(LetAvail,LetPicked))
  1807.         If Correct=false then message "Sorry, not a correct entry. Pick a character in brackets."
  1808.  
  1809.     LOOP WHILE Correct = FALSE
  1810.  
  1811.  
  1812.  
  1813. DONELETTER:
  1814. END SUB
  1815. '*************************************************************************************
  1816. '*************************************************************************************
  1817.  
  1818. SUB DoMove
  1819.  
  1820. DIM dX#,dY#,dZ#,ESC%        ' the user defines the offset wanted
  1821.  
  1822.     GetValue  "Enter an offset in the X-direction",dX#,ESC%
  1823.     GetValue  "Enter an offset in the Y-direction",dY#,ESC%    
  1824.     GetValue  "Enter an offset in the Z-direction",dZ#,ESC%
  1825.  
  1826. WITHOBJECT "CorelCAD.Automation.1"
  1827.     .move 0,0,0,0,0,dX#,dY#,dZ#
  1828. END WITHOBJECT
  1829.  
  1830. END SUB
  1831. '*************************************************************************************
  1832. '*************************************************************************************
  1833. SUB DoScale
  1834.  
  1835. DIM ScaleNum#
  1836. DIM X#,Y#,Z#,ESC%
  1837.  
  1838.     GetValue "Enter a scale factor",ScaleNum#,ESC%
  1839.     GetCoord "SCALE -- Base Point",x#,Y#,Z#,ESC%
  1840.  
  1841. WITHOBJECT "CorelCAD.Automation.1"
  1842.     .Scale 0,ScaleNum#,X,Y,Z
  1843. END WITHOBJECT
  1844.  
  1845. END SUB
  1846. '*************************************************************************************
  1847. '*************************************************************************************
  1848. SUB DoExtrude
  1849.  
  1850.  
  1851. DIM X#,Y#,Z#,X2#,Y2#,Z2#,Scale#,Scalevalue%,ESC%
  1852.  
  1853. withobject"corelcad.automation.1"
  1854. EXTRUDE1:
  1855.      ESC=false
  1856.      Getcoord "EXTRUDE -- Enter the first point:",X#,Y#,Z#,ESC%
  1857.      if ESC=true then goto EXTRUDE3
  1858. EXTRUDE2:
  1859.      ESC=false
  1860.      Getcoord "EXTRUDE -- Enter the  Second point",X2#,Y2#,Z2#,ESC%
  1861.      if ESC=true then goto EXTRUDE1
  1862.   
  1863.      Getvalue "EXTRUDE -- Please enter extrusion scale",scale#,ESC%
  1864.      if ESC=true then goto EXTRUDE2  
  1865.      Scalevalue%=cint(scale)
  1866.  
  1867.  
  1868. .StartAddCmdPoint 2
  1869.     .AddCmdPoint X#,Y#,Z#
  1870.     .addcmdpoint X2#,Y2#,Z2#
  1871. .EndAddCmdPoint
  1872.  
  1873.  
  1874. .extrude .extrudescale = scalevalue
  1875.  
  1876. end withobject
  1877. EXTRUDE3:
  1878.  
  1879. END SUB
  1880. '*************************************************************************************
  1881. '*************************************************************************************
  1882. SUB DoPaste
  1883.  
  1884. DIM X#,Y#,Z#,ESC%
  1885.  
  1886. Withobject "CorelCAD.Automation.1"
  1887.      GetCoord "PASTE -- Enter the coordinate for object placement:",X#,Y#,Z#,ESC%
  1888.     .EditPaste X,Y,Z
  1889. end withobject
  1890.  
  1891. END SUB
  1892.  
  1893.  
  1894. '*************************************************************************************
  1895. '*************************************************************************************
  1896. SUB DoChangeColor
  1897.  
  1898. DIM ColorChoice%
  1899. DIM Color$(7)
  1900. DIM Red%,Green%,Blue%
  1901.  
  1902. ColorChoice = 1
  1903.  
  1904. Color(1)="Red"
  1905. Color(2)="Orange"
  1906. Color(3)="Yellow"
  1907. Color(4)="Green"
  1908. Color(5)="Blue"
  1909. Color(6)="Indigo"
  1910. Color(7) ="Violet"
  1911.  
  1912. BEGIN DIALOG ColorDlg 97, 118, "CHANGE COLOR"
  1913.     GROUPBOX  4, 6, 83, 85, "Colors Available"
  1914.     LISTBOX  15, 20, 62, 67, Color$, ColorChoice%
  1915.     OKBUTTON  6, 100, 40, 14
  1916.     CANCELBUTTON  50, 100, 40, 14
  1917. END DIALOG
  1918.  
  1919. ret = DIALOG(ColorDlg)
  1920. If ret = 2 then goto Done:
  1921.  
  1922. WithObject "CorelCAD.Automation.1"
  1923.  
  1924.     Select Case ColorChoice
  1925.         Case 1
  1926.             .ChangeColor 255, 0, 51
  1927.         Case 2
  1928.             .ChangeColor 255, 153, 0
  1929.         Case 3
  1930.             .ChangeColor 255, 255, 0
  1931.         Case 4
  1932.             .ChangeColor 51, 255, 0
  1933.         Case 5
  1934.             .ChangeColor 0, 0, 255
  1935.         Case 6    
  1936.             .ChangeColor 0, 255, 255
  1937.         Case 7
  1938.             .ChangeColor 51, 0, 102
  1939.     END SELECT
  1940. End WithObject
  1941.  
  1942. DONE:
  1943. END SUB
  1944. '*************************************************************************************
  1945. '*************************************************************************************
  1946. SUB DoZoom
  1947.  
  1948. DIM Zoom$            'letter picked for zoom
  1949. DIM X#,Y#,Z#,X1#,Y1#,Z1#
  1950.  
  1951. ZZ2:
  1952.     GetLetter "Zoom Type","(A)ll,(S)elected,(I)n,(O)ut,(P)revious","ASIOP",Zoom$,ESC%
  1953.     If ESC = true then goto Doo
  1954. Withobject "CorelCAD.Automation.1"
  1955. Select Case Zoom
  1956.     CASE "A"
  1957.         .zoomToAll
  1958.     CASE "S"
  1959.         .ZoomToSelected
  1960.     CASE "I"
  1961. ZZ1:
  1962.         GetCoord "Enter the first point for the zoom box:",X#,Y#,Z#,ESC%
  1963.         If ESC = true then goto ZZ2
  1964.         X1=X
  1965.         Y1=Y
  1966.         Z1=Z
  1967.         GetCoord "Enter the end point for the zoom box:",X1#,Y1#,Z1#,ESC%
  1968.         If ESC = true then goto ZZ1
  1969.         .ZoomIn X,Y,Z,X1,Y1,Z1
  1970.     CASE "O"
  1971.         .ZoomOut 
  1972.     CASE "P"    
  1973.         .ZoomPrevious
  1974. end select
  1975.  
  1976. End Withobject
  1977.     
  1978. doo:
  1979. END SUB
  1980.  
  1981.  
  1982.  
  1983.  
  1984.  
  1985.